#| label: drivers-table
# Fit logistic regression including 'all' significant drivers from the dataset
logit_model <- logistic_reg() %>%
set_engine("glm") %>%
fit(churn ~ . - client.id - attrition.flag, data = attritionData)
# Formatting the comprehensive drivers table
all_drivers_table <- tidy(logit_model, exponentiate = TRUE) %>%
filter(term != "(Intercept)") %>%
mutate(
term = str_to_title(str_replace_all(term, "\\.", " ")),
Impact = case_when(
estimate > 1.05 ~ "Higher Risk",
estimate < 0.95 ~ "Protective Factor",
TRUE ~ "Neutral"
)
) %>%
select(Factor = term, `Risk Multiplier` = estimate, Impact) %>%
arrange(desc(`Risk Multiplier`))
tblData <- all_drivers_table %>%
filter(Factor != "Avg Open To Buy") %>%
mutate(Factor = case_when(
Factor == "Age Bracket50-59" ~ "Age Bracket: 50-59",
Factor == "Age Bracket40-49" ~ "Age Bracket: 40-49",
Factor == "Age Bracket60+" ~ "Age Bracket: 60+",
Factor == "Age Bracket30-39" ~ "Age Bracket: 30-39",
Factor == "Card Categorygold" ~ "Card Category: Gold",
Factor == "Card Categoryplatinum" ~ "Card Category: Platinum",
Factor == "Income Bracket>$120k" ~ "Income: > $120k",
Factor == "Contacts Count 12 Month" ~ "Previous Year Contacts",
Factor == "Months Inactive 12 Months" ~ "Months Inactive Previous 12 Months",
Factor == "Income Bracket$80k-$120k" ~ "Income: $80k to $120k",
Factor == "Card Categorysilver" ~ "Card Category: Silver",
Factor == "Education Leveldoctorate" ~ "Education Level: Doctorate",
Factor == "Education Levelpost-Graduate" ~ "Education Level: Post Graduate",
Factor == "Dependent Count" ~ "Number of Dependents",
Factor == "Income Bracket$60k-$80k" ~ "Income: $60k to $80k",
Factor == "Education Levelunknown" ~ "Education Level: Unknown",
Factor == "Total Transaction Amount" ~ "Total Transaction Amount",
Factor == "Credit Limit" ~ "Credit Limit",
Factor == "Total Revolving Balance" ~ "Total Revolving Balance",
Factor == "Months On Book" ~ "Months On Book",
Factor == "Customer Age" ~ "Customer Age",
Factor == "Education Levelhigh School" ~ "Education Level: High School",
Factor == "Income Bracketunknown" ~ "Income: Unknown",
Factor == "Marital Statusunknown" ~ "Marital Status: Unknown",
Factor == "Education Levelcollege" ~ "Education Level: College",
Factor == "Education Levelgraduate" ~ "Education Level: Graduate",
Factor == "Marital Statusdivorced" ~ "Marital Status: Divorced",
Factor == "Total Transaction Count" ~ "Total Transaction Count",
Factor == "Avg Utilization Rate" ~ "Average Utilization Rate",
Factor == "Income Bracket$40k-$60k" ~ "Income: $40k to $60k",
Factor == "Total Amount Changed Previous Quarter" ~ "Total Amount Changed Previous Quarter",
Factor == "Total Relationship Count" ~ "Total Relationship Count",
Factor == "Marital Statusmarried" ~ "Marital Status: Married",
Factor == "Gendermale" ~ "Gender: Male",
Factor == "Total Count Change Previous Quarter" ~ "Total Count Change Previous Quarter")
)
kbl(tblData, caption = "Comprehensive Analysis of All Account Drivers", digits = 2) %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = F) %>%
column_spec(3, color = "white",
background = case_when(
all_drivers_table$Impact == "Higher Risk" ~ "#df691a",
all_drivers_table$Impact == "Protective Factor" ~ "#5cb85c",
TRUE ~ "#999999")
) %>%
scroll_box(width = "100%", height = "500px")